home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops Manual / Demo folder / Turtle < prev   
Encoding:
Text File  |  1994-10-24  |  3.4 KB  |  138 lines  |  [TEXT/MSET]
  1. \  Turtle Graphics Objects for Demo
  2.  
  3. need    sin
  4.  
  5. decimal
  6.  
  7. \ Class PEN defines a turtle-graphics pen.
  8.  
  9. :class    PEN    super{ object }
  10.  
  11. record{            \ These first 5 ivars comprise a PenState structure
  12.     point    PnLoc            \ location of pen
  13.     point    PnSize            \ width,  height
  14.     int        PnMode
  15.     var        PnPatLo
  16.     var        PnPatHi
  17. }
  18.     angle    Direction
  19.     point    homeLoc 
  20.     int        maxReps
  21.     int        initLen
  22.     int        deltaLen            \ change in len
  23.     int        deltaDeg            \ change in angle
  24.  
  25.  
  26. :m GET:    ^base   call GetPenState   ;m        \ Save state here
  27. :m SET:    ^base   call SetPenState   ;m        \ Restore from here
  28.  
  29. :m TURN:  ( deg -- )    +: direction   ;m
  30.  
  31. :m UP:        90 put: direction   ;m
  32.  
  33. :m MOVETO:    \ ( x y -- )    Draws a line to x,y if pen shows
  34.     set: self  pack  call LineTo  get: self   ;m
  35.  
  36. :m MOVE:  { dist  -- }    \ Draws dist bits in current direction
  37.     set: self  cos: direction  dist * 10000 /
  38.     sin: direction  dist * 10000 /   negate
  39.     pack  call Line  get: self    ;m
  40.        
  41. :m GOTO:    \ ( x y -- )    Goes to a location without drawing
  42.     put:  PnLoc   ;m
  43.    
  44. :m CENTER:    \ ( x y -- )    Sets the center coordinates
  45.     put: homeLoc   ;m
  46.    
  47. :m HOME:    \ ( -- )        Places pen in center of Mops window
  48.     get: homeLoc  goto: self   ;m
  49.  
  50. :m SIZE:        \ ( w h -- )    Sets size in pixels of drawing pen
  51.     put: PnSize   ;m
  52.  
  53. :m INIT:        \ ( x y w h mode  -- )
  54.     put:  PnMode  put: PnSize   put: PnLoc   ;m
  55.  
  56. :m PUTRANGE:        \ ( initlen dLen dDeg -- )      Sets parameters
  57.     put: deltaDeg  put: deltaLen  put: initLen   ;m
  58.  
  59. :m PUTMAX:   ( maxReps -- )    put: maxReps   ;m
  60.  
  61. :m CLASSINIT:   get: self   200 put: maxReps   ;m
  62.  
  63. :m SPIRAL:  { \ dist  degrees delta  reps -- }
  64.             \ Draws a spiral of line segments - Logo POLYSPI
  65.     home: self
  66.     get: initLen  -> dist  get: deltaLen  -> delta
  67.     get: deltaDeg  -> degrees   0 -> reps
  68.     begin    1 ++> reps  reps  get: maxReps  < 
  69.     while    dist  move: self   degrees  turn: self
  70.         delta ++> dist  
  71.     repeat   ;m
  72.  
  73. :m DRAGON:    \ ( n -- )    Dragon curves from Martin Gardner
  74.     dup
  75.     NIF    get: deltaLen  move: self  drop  
  76.     ELSE    dup  0> 
  77.         IF    dup  1-  dragon: self  
  78.             get: deltadeg  turn: self
  79.             1 swap -   dragon: self 
  80.         ELSE
  81.             -1 over -   dragon: self
  82.             360 get: deltadeg  -  turn: self
  83.             1+  dragon: self 
  84.         THEN
  85.     THEN   ;m
  86.         
  87. :m LJ:  { \ reps -- }    \ Draws an infinite Lissajous figure 
  88.     up: self   0 -> reps
  89.     get: initLen   get: direction  *  cos    120 /          getX: homeLoc  +
  90.     get: deltalen  get: direction  *  sin   120 /  negate  getY: homeLoc  +
  91.     goto: self 
  92.     begin   1 ++> reps  reps  get: maxReps  <
  93.     WHILE
  94.         get: initLen    get: direction  *  cos 120 /  getX: homeLoc +
  95.         get: deltaLen get: direction  *  sin  120 /  negate
  96.         getY: homeLoc + moveTo: self
  97.         get: deltaDeg turn: self
  98.     REPEAT   ;m
  99. ;class
  100.  
  101. \ Define a Smalltalk Polygon object as subclass of Pen 
  102.  
  103. :class  POLY    super{  pen  }
  104.  
  105.     int    Sides        \ # of sides in the Polygon  
  106.     int    Length        \ Length of each side  
  107.  
  108. :m DRAW:  { \ turnAngle -- }
  109.     360  get: sides  /   -> turnAngle
  110.     get: sides  0
  111.     do    get:  length  move: self  
  112.         turnAngle  turn: self
  113.     loop   ;m
  114.  
  115. :m SIZE:        \ ( len  #sides -- )    Stores sides and goes to Home
  116.     get: self  put: sides  put: length 
  117.     home:  self   up: self   ;m
  118.  
  119. :m SPIN:  { \ reps -- }        \ Spins a series of polygons around a point  
  120.     home: self  10 get: initLen  size: self
  121.     0 -> reps 
  122.     BEGIN    reps  get: maxReps  < 
  123.     WHILE    draw: self  get: deltaDeg  turn: self
  124.         get: deltaLen  +: length  1 ++> reps
  125.     REPEAT   ;m
  126.      
  127. :m CLASSINIT:        \ Default Poly is 30-dot triangle
  128.     30 3 size: self  100 put: maxReps   ;m
  129.  
  130. ;class
  131.  
  132. \ Create a pen named Bic
  133. Pen    BIC
  134.  
  135. \ Create a Polygon named Anna
  136. Poly    ANNA
  137. 60 4  Size: Anna
  138.